COMMENT ⊗   VALID 00003 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	C********************* DPYIT .F4 ***********************************
C00008 00003		SUBROUTINE CMBN
C00013 ENDMK
C⊗;
C********************* DPYIT .F4 ***********************************
C**** SUBRS LINES, RDRAW, GRIDS, SHIFT, CMBN, A5IN, RDSAV, BUP, POG2, POG1
	SUBROUTINE LINES(A,B,L)
	COMMON /RZ/RSZ,RJB,CENTR 
	COMMON /FL/C,D,NQ,RZ
CIRC	1 /DPY/NDP,IOV
	COMMON/MN/M,N
	M=A*RSZ
	N=B*RSZ

	IF(IABS(M).GT.800.OR.IABS(N).GT.800)RETURN
C DON'T DISPLAY LINES TOO FAR OFF SCREEN. THEY CAUSE CONFUSION.

CIRC	LX=0
CIRC	IF(L.EQ.3)LX=1
	IF(L.EQ.3)CALL AIVECT(M,N)
CIRC	CALL VECT(IOV,M,N,LX)
C    L.NE.0 = INVISIBLE,    L.EQ.0 = VISIBLE.
	IF(L.NE.3)CALL AVECT(M,N)
	END    

	SUBROUTINE RDRAW(IPOG,I,JJ,IJ)
C   TO X,Y INTO ONE WORD
	DIMENSION IJ(1)
	COMMON /RC/MCLEF(1100),IST(4000)
	COMMON /RZ/RSZ,RJB,CENTR
	COMMON/LL/L  /ZN/SCLEF(2,1100),DDD /MN/M,N
	COMMON /GRD/GRD(1100)
	IF(IPOG.EQ.3)CALL DPYSET(3,GRD,700)
C1/82	IF(IPOG.EQ.3)CALL DPYSET(3,GRD,400)
	IF(IPOG.EQ.1)CALL DPYSET(1,IST,4000)
	DO 2 K=I,JJ
	CALL UNPACK(IA,IB,L,IJ(K))
	A=IA+RJB
	B=IB+CENTR
	IF(K.EQ.I)GO TO 3
	IF(L.LT.100000000)GO TO 1
3	L=3
1	CALL LINES(A,B,L)
	SCLEF(1,K)=M
2	SCLEF(2,K)=N
	CALL DPYOUT(IPOG)
	END

	SUBROUTINE GRIDS
	COMMON /RZ/RSZ,RJB,CENTR
CIRC	COMMON /DPY/NDP,IOV,GRID
	COMMON /GRID/GRID
	DIMENSION LWRCS(9),IUPCS(8)
	COMMON /GRD/GRD(1100)
	DATA LWRCS/9,110281028,10280045,210045,211028,10281028
	1,210280017, 10030017,10031028/
	1,IUPCS/8,110281028,10280045,370045,371028,10281028
	1, 100041028, 40045/
	NDP=2
	IOV=2
CIRC	CALL DPYSET(300,NDP)
	CALL DPYSET(3,GRD,700)
C1/82	CALL DPYSET(3,GRD,400)
	IF(GRID.GT.0)GO TO 9
	NDP=1
C  -1 MAKES GRID DISAPPEAR
	GO TO 1
9	IF(GRID.EQ.1)GO TO 2
	IF(GRID.EQ.3)GO TO 3
C  NEXT IS UPPER CASE BOX -- GRID=2
CIRC	CALL RDRAW(2,IUPCS(1),IUPCS,RJB,CENTR)
	CALL RDRAW(3,2,IUPCS(1),IUPCS)
	GO TO 1
CIRC3	CALL RDRAW(2,LWRCS(1),LWRCS,RJB,CENTR)
3	CALL RDRAW(3,2,LWRCS(1),LWRCS)
C  LOWER CASE BOX
	GO TO 1
2	RB=32
	RC=31.*9./RSZ
	RD=74.*9./RSZ
	RA=2
	DO 30 L=-30,70,4
	RZ=L
	RE=RZ+CENTR
	IF(L.EQ.-2)GO TO 4
	IF(L.EQ.18)GO TO 4
	IF(L.EQ.38)GO TO 4
	IF(L.NE.58)GO TO 32
4	RF=RE+1
	RG=RE+3
	CALL LINES(RJB-1.0,RG,3)
	CALL LINES(RJB+1.0,RF,2)
	CALL LINES(RJB+19.0,RG,3)
	CALL LINES(RJB+21.0,RF,2)
32	XA=2
	XB=0
	IF(L.EQ.14)GO TO 6
	IF(L.NE.42)GO TO 5
6	XA=20
5	IF(L.EQ.-2)GO TO 8
	IF(L.EQ.26)GO TO 8
	IF(L.NE.54)GO TO 7
8	XB=20
7	CALL LINES(RJB-RA-XA,RE,3)
	CALL LINES(RJB+RB+XA,RE,2)
	CALL LINES(RJB+RB+XB,RE+2.0,3)
30	CALL LINES(RJB-RA-XB,RE+2.0,2)
	DO 31 L=-2,32,4
	RZ=L
	RE=RZ+RJB
	CALL LINES(RE,CENTR-RC,3)
	CALL LINES(RE,CENTR+RD,2)
	CALL LINES(RE+2.0,CENTR+RD,3)
31	CALL LINES(RE+2.0,CENTR-RC,2)
	CALL LINES(RJB-10.,CENTR-14.,3)
	CALL LINES(RJB,CENTR-14.,2)
	CALL LINES(RJB,CENTR-28.,3)
	CALL LINES(RJB-10.,CENTR-28.,2)
CIRC1	CALL DPYOUT(NDP)
CIRC	IOV=1
C IOV=1 = NO MORE OVERLAY INPUT
1	CALL DPYOUT(3)
	END

	SUBROUTINE SHIFT(M,L,NN)
	DIMENSION M(1)
	IF(NN.NE.'Q')GO TO 12
C NEXT IS FOR REPEAT OF MOVE OR ROTATE. TYPE 'Q' TO REPEAT.
	H=OH
	V=OV
	SH=OSH
	SV=OSV
C GET BACK OLD NUMBERS AND COMMAND LETTER
	NN=MOVROT
	GO TO 10
12	IF(NN.EQ.'M')GO TO 5
C NOW WE ROTATE
	TYPE 7
	GO TO 6
5	TYPE 1
C NOW WE MOVE
6	ACCEPT 2,H,V,SH,SV
	MOVROT=NN
	IF(SH.EQ.0)SH=1
	IF(SV.EQ.0)SV=1
	OH=H
	OV=V
	OSH=SH
	OSV=SV
C SAVE NUMBERS FOR REPEAT FEATURE
1	FORMAT(' MOVE HORIZ, VERT., SIZE H, SIZE V'/)
2	FORMAT(4F)
7	FORMAT(' TYPE DEGREES -- '$)
10	DO 3 K=1,L-1
	CALL UNPACK(J,N,NO,M(K))
	IF(NN.EQ.'M')GO TO 4
C   ROTATION      DEGREES.
	X=J
	Y=N
	AX=ATAN2(Y,X)*57.2957768
	HYP=SQRT(X**2+Y**2)
	ROT=AX+H
CC	ROT=AX-H
C**NO**  -H, SO ROTATION IS CLOCKWISE INSTEAD OF CNTRCLKWS.
C  H=DEGREES
	X=HYP*COSD(ROT)
	Y=HYP*SIND(ROT)
	AX=.5
	IF(X)AX=-AX
C  AX IS FOR ROUND-OFF
	J=X+AX
	AX=.5
	IF(Y)AX=-AX
	N=Y+AX
	GO TO 3

4	J=H+J*SH
	N=V+N*SV
3	CALL REPACK(J,N,NO,M(K))
	END

	SUBROUTINE CMBN
	COMMON /RC/MCLEF(1)
	COMMON /FL/NX,N,L,M
	COMMON /SAV/JCLEF(10),KCLEF(10),NMLST(10)
	DIMENSION IP(10),NMS(10),NF(1150)
C1/82	DIMENSION IP(10),NMS(10),NF(450)
C  USE FILE NAMES CLFX, DRAW1 AND DRAW2.  1100 WD LIMIT PER FILE.
102	TYPE 1
1	FORMAT(' TYPE OUTPUT FILE NAME ',$)
	DO 122 K=1,10
	IP(K)=0
122	NMS(K)=' '
	CALL A5IN(NM)
	IF(NM.EQ.'B'.OR.NM.EQ.'99')RETURN
	IF(NM.NE.' ')GO TO 40
	NM=LASTNM
	TYPE 107,LASTNM
40	LASTNM=NM
	IF(LOOKF(NM).EQ.0)GO TO 100
	GO TO 103
100	TYPE 109
	CALL A5IN(NMLST)
	IF(NMLST(1).EQ.' ')GO TO 102
	JCLEF(1)=1
	DO 1111 K=2,10
	JCLEF(K)=0
1111	NMLST(K)=' '
	CALL RDSAV(JCLEF,NMLST,MCLEF,NM,MCLEF,0)
	RETURN   

1103	TYPE 1104
1104	FORMAT(' FILE FULL -- SAVED AS "FULL.DMD"')
	L=1
	NM='FULL'
	NX=MCLEF(1)
	NMS(1)=ID
	IP(2)=0
	DO 1105 K=2,10
1105	NMS(K)=' '
	GO TO 14

103	CALL RDSAV(IP,NMS,NX,NM,NF,-1)
107	FORMAT(1X,A5)
	TYPE 109
109	FORMAT(' TYPE ID NAME (<CR>=BACKUP) -- ',$)
	CALL A5IN(ID)
	IF(ID.EQ.' ')GO TO 102
	JD=0
	L=0
	DO 110 K=1,10
	IF(NMS(K).EQ.ID)JD=K
	IF(NMS(K).EQ.' ')GO TO 112
	L=K
110	IF(JD.EQ.0.AND.K.EQ.10)GO TO 1103
112	IF(N.EQ.'Z')GO TO 127
C  FOR DELETIONS
	L=L+1
	IF(JD.NE.0)GO TO 111
C ADDS ON TO END
	N=0
	IP(L)=NX+1
	DO 113 K=NX+1,MCLEF(1)+NX
	N=N+1
113	NF(K)=MCLEF(N)
	NX=NX+N
	NMS(L)=ID
	L=L+1
114	DO 115 K=1,NX
115	MCLEF(K)=NF(K)
C MOVES IT ALL TO MCLEF
14	CALL RDSAV(IP,NMS,NX,NM,MCLEF,0)
	L=NX
	RETURN

127	MCLEF(1)=0
111	N=IP(JD)
	NR=MCLEF(1)
	M=NF(IP(JD))
	NW=NR-M
	NX=NX+NW
	IF(NW)201,120,203
201	JA=N+NR
	JB=NX
	JC=1
	GO TO 204
203	JA=NX
	JB=N+NW
	JC=-1
204	DO 121 K=JA,JB,JC
121	NF(K)=NF(K-NW)
	IF(NR.EQ.0)GO TO 126
120	DO 117 K=1,NR
	NF(N)=MCLEF(K)
117	N=N+1 
	IF(NW.EQ.0)GO TO 114
	DO 119 K=JD+1,L
119	IP(K)=IP(K)+NW
C  FIXES UP FIRST LINE.
	GO TO 114
126	IP(L+1)=0
	DO 124 K=JD,L-1
	IP(K)=IP(K+1)+NW
124	NMS(K)=NMS(K+1)
	NMS(L)=' '
	GO TO 114
	END

	SUBROUTINE A5IN(N)
10	FORMAT(A5)
	ACCEPT 10,N
	CALL LO2UP(N)
	END

	SUBROUTINE RDSAV(KT,NMS,K,NAME,IO,L)
C  POINTER LIST, NAME LIST, WDCNT, FILE NAME, DATA, RD OR WRT.
	COMMON /RC/MCLEF(1)  /FL/IC,NH,NQ,A
	DIMENSION KT(1),NMS(1),IO(1),JALL(21)
	IF(L)GO TO 5
C  L=-1  FOR READER, -2=NO TYPE OF NAME LIST.
	DO 1 N=1,10
	JALL(N)=KT(N)
1	JALL(N+11)=NMS(N)
	JALL(11)=K
	TYPE 6,K
C THESE ROUTINES ARE IN 'MSSIO.FAI'
	CALL PUTEXT(NAME,'DMD')
	CALL EXTOUT(JALL,21)
	CALL EXTOUT(IO,K+1)
	CALL FINEXT
	RETURN

5	CALL GETEXT(NAME,'DMD')
	CALL EXTIN(JALL,21)
	K=JALL(11)
	TYPE 6,K
6	FORMAT(' TOTAL WDS=',I3,'/350')
	CALL EXTIN(IO,K)
	DO 2 N=1,10
	KT(N)=JALL(N)
2	NMS(N)=JALL(N+11)
	IF(L.EQ.-2)RETURN
	TYPE 3
	TYPE 4,(NMS(N),N=1,10)
3	FORMAT(
	1'  0      1      2      3      4      5      6      7
	1      8      9')
4	FORMAT(' IDENT. NAMES:'/,10(2XA5))
	END

	SUBROUTINE BUP
	COMMON/RC/MCLEF(1100),IST1,IST2
	IST2=IST2-1
	CALL HYDPOG(1)
	CALL ACCPOG(1)
	END

	SUBROUTINE POG2
	COMMON /RC/MCLEF(4100),IST(1000)
C1/82	COMMON /RC/MCLEF(3400),IST(1000)
	CALL DPYSET(2,IST,200)
	CALL DPYBRT(2)
	END

	SUBROUTINE POG1
	CALL HYDPOG(3)
	CALL SETPOG(1)
	CALL DPYBRT(4)
	END